home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / macscripts / 4112Balloon next >
Text File  |  1993-10-23  |  2KB  |  90 lines
  1. Perl -Sx "{0}" {"Parameters"}
  2. Exit
  3.  
  4. #!/usr/local/bin/perl
  5.  
  6. $in = shift ARGV;
  7.  
  8. unlink("MacPerl Help") if -e "MacPerl Help";
  9. dbmopen(HELP, "MacPerl Help", 0);
  10. open(IN, $in) || die "Couldn't open \"$in\"";
  11.  
  12. $lastpos = 0;
  13.  
  14. while (<IN>) {
  15.     if (/^æKY\s+(\S+)/) {
  16.         while ($key = shift @keys) {
  17.             $HELP{"\000" . $key} = pack("LL", $startpos, $lastpos);
  18.         }
  19.         @keys = ($1);
  20.         $startpos = tell(IN);
  21.         while (<IN>) {
  22.             last unless /^([^ \tæ]\S+)/;
  23.             push(@keys, $1);
  24.             $startpos = tell(IN);
  25.         }
  26.     }
  27.     if (/^æC\s+(\S.+)/) {
  28.         do {
  29.             &additem($1);
  30.             $_ = <IN>;
  31.         } while (/^(\S.+)/);
  32.     }
  33. } continue {
  34.     $lastpos = tell(IN);
  35. }
  36.  
  37. foreach $key (keys HELP) {
  38.     next if $key =~ /^\000/;
  39.     
  40.     @items = split(/\n/, $HELP{$key});
  41.     
  42.     push(@items, " ") while ($#items < 5);
  43.     
  44.     $HELP{$key} = join("\n", @items);
  45. }
  46.  
  47. dbmclose(HELP);
  48.  
  49. $offset = (stat("MacPerl Help"))[7];
  50.  
  51. dbmopen(HELP, "MacPerl Help", 0);
  52. foreach $key (keys HELP) {
  53.     next unless $key =~ /^\000/;
  54.     
  55.     ($startpos, $lastpos) = unpack("LL", $HELP{$key});
  56.     
  57.     $startpos += $offset;
  58.     $lastpos += $offset;
  59.     
  60.     $HELP{$key} = pack("LL", $startpos, $lastpos);
  61. }
  62. dbmclose(HELP);
  63.  
  64. open(HELP, ">>MacPerl Help");
  65. seek(HELP, 0, 2);
  66. seek(IN, 0, 0);
  67.  
  68. print HELP <IN>;
  69.  
  70. close(HELP);
  71.  
  72. sub additem {
  73.     local($item) = @_;
  74.     local($key);
  75.     
  76.     if ($item =~ /^([A-Za-z]+)/) {
  77.         $key = $1;
  78.     } elsif ($item =~ /^&([A-Za-z]+)/) {
  79.         $key = $1;
  80.     } else {
  81.         $key = substr($item, 0, 1);
  82.     }
  83.     if (defined $HELP{$key}) {
  84.         @items = split(/\n/, $HELP{$key});
  85.         push(items, $item);
  86.         $HELP{$key} = join("\n", sort {length($b) <=> length($a)} @items);
  87.     } else {
  88.         $HELP{$key} = $item;
  89.     }
  90. }